00100		SUBROUTINE ZFUNC
00200		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
00300		1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
00400		COMMON FUNC(512),F2(512),K,I
00500	
00600	43	TYPE 1
00700		ACCEPT 100,MA,C
00720		IF(MA.NE.'B')GO TO 76
00740	430	KT=512
00760	C  FOR BACKUP
00780		RETURN
00900	76	IF(MA.NE.'A'.AND.MA.NE.'M')GO TO 73
00950	75	TYPE 39,B
01000		TYPE 2
01100		ACCEPT 3,FNM2
01150		IF(FNM2.EQ.'B')GO TO 43
03000	40	DO 4 K=1,10
03100	5	IF(FNM2.NE.FN(K))GO TO 4
03200		N2=K
03300		GO TO 72
03400	4	CONTINUE
03500		TYPE 74
03600		GO TO 75
03700	74	FORMAT(' FUNCTION NOT FOUND '/)
03800	72	CALL DPYF(N2,F2)
03910	7	TYPE 60
03940		ACCEPT 100,K
03970		IF(K.EQ.'B'.OR.K.EQ.'N')GO TO 15
03980		IF(MA.EQ.'M')GO TO 102
04000	70	TYPE 10
04100		ACCEPT 11,R,R2
04150		REREAD 100,K
04175		IF(K.EQ.'B')GO TO 75
04200		IF(R2.EQ.0)R2=1
04300		IF(R.EQ.0)R=1
04400		DO 13 K=1,512
04450		X=FUNC(K)
04500		FUNC(K)=FUNC(K)*R+F2(K)*R2+C
04550	13	F2(K)=X
04600		GO TO 104
04700	73	IF(MA.NE.'C')GO TO 44
04716		DO 45 K=1,512
04732		F2(K)=FUNC(K)
04748	45	FUNC(K)=FUNC(K)+C
04764		GO TO 104
04780	44	IF(MA.NE.'I')GO TO 46
04796		DO 47 K=1,512
04812		F2(K)=FUNC(K)
04828	47	FUNC(K)=C-FUNC(K)
04844		GO TO 104
04860	46	IF(MA.NE.'R')GO TO 75
04876	48	DO 50 K=1,512
04892	50	F2(K)=FUNC(513-K)
04908		DO 51 K=1,512
04924		X=FUNC(K)
04940		FUNC(K)=F2(K)+C
04956	51	F2(K)=X
04972		GO TO 104
05000	102	DO 103 K=1,512
05050		X=FUNC(K)
05100		FUNC(K)=FUNC(K)*F2(K)+C
05150	103	F2(K)=X
05200	104	A(1,2)=520
05300		CALL NORM(FUNC)
05400	C   NORMALIZES THE FUNCTION
05500		CALL DPY(FUNC,1)
05600		TYPE 6
05700		ACCEPT 100,K
05800		IF(K.EQ.'M')GO TO 43
05900		IF(K.NE.'B')RETURN
05910		DO 14 K=1,512
05920	14	FUNC(K)=F2(K)
05940	15	CALL DPY(FUNC,1)
05950		GO TO 43
06000	1	FORMAT
06050	     1(' A(DD), M(ULT), R(ETRO), I(NVRT), OR C,N (=ADD CONSTANT N) ',$)
06100	100	FORMAT(A1,F)
06200	2	FORMAT(' 2ND FUNC? ',$)
06300	3	FORMAT(A3)
06400	10	FORMAT(' TYPE RATIO (E.G. 1,2) ',$)
06410	39	FORMAT(10(A1,A3))
06500	11	FORMAT(2F)
06600	6	FORMAT(' F(INISH), OR M(ORE)?  ',$)
06650	60	FORMAT(' GO ON?  ',$)
06700		END
06800	
06900		SUBROUTINE DPYF(N,F)
07000		COMMON/S/H,AMP,CON,PH
07100		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
07200		1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
07300		DIMENSION F(1)
07305		NODPY=-1
07310		IF(N.GT.0)GO TO 8
07320		N=JX
07330		NODPY=0
07400	8	IF(XA(N).EQ.'SEG')GO TO 5
07500		CALL ZERO(F)
07600		K=1
07700	1	AMP=AA(2,K,N)
07800		H=AA(1,K,N)
07900		PH=AA(3,K,N)
08000		CON=AA(4,K,N)
08100		CALL SYN(F)
08200		K=K+1
08300		IF(AA(1,K,N).NE.999)GO TO 1
08400		CALL NORM(F)
08500		GO TO 4
08800	
08900	5	K=1
09000		IF(AA(2,1,N).EQ.520)GO TO 6
09100		Y=AA(1,1,N)
09200		J=1
09300	2	K=K+1
09400		M=AA(2,K,N)*5.12+.5
09500		IF(M.GT.512)GO TO 6
09600		G=AA(1,K,N)
09700		Z=G-Y
09800		H=M-J+1
09850		IF(H.LT.1)H=1
09900		NN=0
10000		DO 3 L=J,M
10100		F(L)=(NN*Z)/H+Y
10200	3	NN=NN+1
10300		IF(M.EQ.512)GO TO 4
10400		Y=G
10500		J=M+1
10600		GO TO 2
10700	C  FOR LONG FUNCS.
10800	6	L=K+1
10900		DO 7 M=1,512
11000	7	F(M)=AA(M,L,N)
11100	4	IF(NODPY)CALL DPY(F,-1)
11110	C  NODPY=0 IS FOR PLOTTER AND LPT
11200	C  NOW FUNCTION IS FULL AND DISPLAYED
11300		RETURN
11400		END
11500	
11600		SUBROUTINE SYN(F)
11700		COMMON/S/H,AMP,CON,PH
11800		DIMENSION F(1)
11900		DATA FAC/0.703125/,FACP/1.422222/
12000		X=PH*FACP+1.0
12100	C  PHASE IS IN DEGREES (0 - 360)
12200	2016	DO 17 L=1,512
12300		XL=SIND(X*FAC)*AMP+CON
12400		IF(CON.LT.100.0)GO TO 1
12500		F(L)=(XL-100.)*F(L)
12600		GO TO 2
12700	1	F(L)=F(L)+XL
12800	C   NORMALIZES THE FUNCTION
12900	2	X=X+H
13000	17	IF(X.GT.512.)X=X-512.
13100		RETURN
13200		END
13300	
13400		SUBROUTINE ZERO(F)
13500		DIMENSION F(1)
13600		DO 1 K=1,512
13700	1	F(K)=0
13800		RETURN
13900		END
14000	
14100		SUBROUTINE NORM(F)
14200		DIMENSION F(1)
14300		X=F(1)
14400	C   NORMALIZES THE FUNCTION
14500		DO 19 K=2,512
14600		XK=ABS(F(K))
14700	19	IF(X.LT.XK)X=XK
14800		DO 20 K=1,512
14900	20	F(K)=F(K)/X
15000		RETURN
15100		END